home *** CD-ROM | disk | FTP | other *** search
/ Acorn RISC PD-CD 1 / Acorn RISC PD-CD 1.iso / utilities / _apps_3 / smallapps2 / _tidydisc / runimagerb < prev   
Encoding:
Text File  |  1994-03-12  |  10.3 KB  |  301 lines
  1.    10 REM >!RunImage for Tidy Disc Version 1.09 12/03/94
  2.    20 :
  3.    30 REM Copyright © Anthony Brion 1993/94.
  4.    40 :
  5.    50 REM ***************************  Copyright Notice  ****************************
  6.    60 REM *  All program code is the copyright of Anthony Brion and the ‘borrowing’ *
  7.    70 REM *    any part of it without the permission of the author is prohibited.   *
  8.    80 REM ***************************************************************************
  9.    90 :
  10.   100 REM #turbo
  11.   110 :
  12.   120 ON ERROR PROCerror
  13.   130 :
  14.   140 RT%=TIME
  15.   150 :
  16.   160 DIM value% 1024,variable% 256
  17.   170 :
  18.   180 RENAME$="!BOOT!RUN!RUNIMAGE!SPRITES!SPRITES22!SPRITES23!HELPMESSAGESSETUPTEMPLATES!CHOICES!SETUPDESC!MENU!CONFIGSOURCERUNIMAGERBREADMEINTMETRICS0OUTLINES0OBJECT"
  19.   210 fixed%=0
  20.   220 rename%=0
  21.   230 errors%=0
  22.   240 DIM Fname% 256
  23.   250 DIM title% 246
  24.   260 CFSlength%=0
  25.   270 length%=0
  26.   320 Lenght%=0
  27.   330 CFSlength%=0
  28.   340 CFSK%=0
  29.   350 K%=0
  30.   360 Len%=0
  31.   370 :
  32.   380 OFF
  33.   390 :
  34.   400 REM #register J%
  35.   410 REM #register X%
  36.   420 REM #register Len%
  37.   430 REM #register length%
  38.   440 :
  39.   450 REM Get the full path of this utility
  40.   460 path$=FNread_system_variable_value("TidyDisc$Dir")
  41.   470 :
  42.   480 REM Extract the root directory of this path ie. upto and including the first $
  43.   490 root$=""
  44.   500 X%=1
  45.   510 REPEAT
  46.   520   character$=MID$(path$,X%,1)
  47.   530   root$+=character$
  48.   540   X%+=1
  49.   550 UNTIL character$="$"
  50.   560 Rootlen=LEN(root$)+1
  51.   570 :
  52.   580 REM If the root directory is in the CFS convert it to a normal directory
  53.   590 IF FNupper(LEFT$(root$,4))="CFS#" THEN root$=RIGHT$(root$,LEN(root$)-4)
  54.   600 :
  55.   610 $title%="Tidy Disc - © Anthony Brion 1994 - "+root$
  56.   620 SYS "Wimp_CommandWindow",title%
  57.   621 OFF
  58.   625 PRINT "Tidy Disc - Freeware - Version 1.09 (12 Mar 94)"'
  59.   630 :
  60.   640 A%=0
  61.   650 B%=0
  62.   660 REM #noturbo
  63.   670 FOR X% = 1 TO LEN(root$)
  64.   680   IF B%=0 AND MID$(root$,X%,1)=":" THEN B%=X%
  65.   690   IF MID$(root$,X%,1)=":" THEN A%=X%
  66.   700 NEXT
  67.   710 REM #turbo
  68.   720 FS$=LEFT$(root$,(B%-1))
  69.   730 PRINT"Changing filing system to ... ";FS$'
  70.   740 OSCLI(FS$)
  71.   750 A%-=1
  72.   760 Drive$=RIGHT$(root$,LEN(root$)-A%)
  73.   770 Drive$=LEFT$(Drive$,LEN(Drive$)-2)
  74.   780 PRINT "Compacting drive...... ";Drive$;"   ";
  75.   790 REPEAT
  76.   800   T%=TIME
  77.   810   OSCLI("COMPACT "+Drive$)
  78.   820 UNTIL (TIME - T%) < 5
  79.   830 PRINT "(Finished)"'
  80.   840 :
  81.   850 REM Process the entire disc starting at the root directory
  82.   860 SYS"Hourglass_On"
  83.   870 PROCscan(root$)
  84.   880 SYS"Hourglass_Off"
  85.   890 :
  86.   900 REM Statistics
  87.   920 PRINT STRING$(Len%,CHR$127);'
  88.   950 PRINT "      Number of fixes : ";fixed%
  89.   960 PRINT "    Number of renames : ";rename%'
  90.  1030 PRINT "     Number of errors : ";errors%
  91.  1040 :
  92.  1050 PRINT '"Re-compacting drive...... ";Drive$;"... ";
  93.  1060 REPEAT
  94.  1070   T%=TIME
  95.  1080   OSCLI("COMPACT "+Drive$)
  96.  1090 UNTIL (TIME - T%) < 5
  97.  1100 PRINT "Finished."
  98.  1110 :
  99.  1120 RT%=TIME-RT%
  100.  1130 RT%=RT%/100
  101.  1140 RTH%=RT%/3600
  102.  1150 RT%-=(RTH% * 3600)
  103.  1160 RTM%=RT%/60
  104.  1170 RT%-=(RTM% * 60)
  105.  1180 PRINT''"  Disc tidy run time : ";FNtwo(RTH%);":";FNtwo(RTM%);":";FNtwo(RT%)''
  106.  1190 :
  107.  1200 REM Program completed normally
  108.  1210 VDU7:REM Beep when finished.
  109.  1220 END
  110.  1230 :
  111.  1240 DEF PROCscan(root$)
  112.  1250 PRINT STRING$(Len%,CHR$127);root$;
  113.  1260 Len%=LEN(root$)
  114.  1270 :
  115.  1280 LOCAL block%,off%,name$,J%,dir%,num%
  116.  1290 DIM block% 40
  117.  1300 off% = 0
  118.  1310 :
  119.  1320 REPEAT
  120.  1330   SYS "OS_GBPB",10,root$,block%,1,off%,40,"*" TO ,,,num%,off%
  121.  1340   IF num%=1 THEN
  122.  1350     J% = 20 : REPEAT : J% += 1 : UNTIL block%?J%=0
  123.  1360     block%?J% = 13 : name$ = $(block%+20)
  124.  1370     dir% = (block%!16=2)
  125.  1380     :
  126.  1390     rootname$=root$+"."+name$
  127.  1400     cfsrootname$="CFS#"+rootname$
  128.  1410     :
  129.  1420     REM Reformat filenames
  130.  1430     :
  131.  1440     IF NOT dir% THEN
  132.  1450       REM Obtain the filetype
  133.  1460       TYPE$=FNreadtype(rootname$)
  134.  1470       CFSTYPE$=FNreadtype(cfsrootname$)
  135.  1480       :
  136.  1490       REM Get file size
  137.  1500       :
  138.  1510       $Fname%=cfsrootname$+CHR$0
  139.  1520       SYS"OS_File",17,Fname% TO ,,,,CFSlength%
  140.  1530       CFSlength1%=CFSlength%/1024
  141.  1540       CFSK%+=(CFSlength1%+1)
  142.  1550       :
  143.  1560       $Fname%=rootname$+CHR$0
  144.  1570       SYS"OS_File",17,Fname% TO ,,,,length%
  145.  1580       length1%=length%/1024
  146.  1590       K%+=(length1%+1)
  147.  1600       :
  148.  1610       REM CFStotal%=CFStotal%+CFSlength%
  149.  1620       REM total%=total%+length%
  150.  1630       :
  151.  1640       Uname$=FNupper(name$)
  152.  1650       IF (INSTR(RENAME$,Uname$,1)<>0) THEN
  153.  1660         done%=0
  154.  1670         CASE Uname$ OF
  155.  1680           WHEN "!BOOT"      :PROCrename("!Boot",Uname$)     :name$="!Boot"
  156.  1690           WHEN "!RUN"       :PROCrename("!Run",Uname$)      :name$="!Run"
  157.  1700           WHEN "!RUNIMAGE"  :PROCrename("!RunImage",Uname$) :name$="!RunImage"
  158.  1710           WHEN "!SPRITES"   :PROCrename("!Sprites",Uname$)  :name$="!Sprites"
  159.  1720           WHEN "!SPRITES22" :PROCrename("!Sprites22",Uname$):name$="!Sprites22"
  160.  1730           WHEN "!SPRITES23" :PROCrename("!Sprites23",Uname$):name$="!Sprites23"
  161.  1740           WHEN "!HELP"      :PROCrename("!Help",Uname$)     :name$="!Help"
  162.  1750           WHEN "MESSAGES"   :PROCrename("Messages",Uname$)  :name$="Messages"
  163.  1760           WHEN "SPRITES"    :PROCrename("Sprites",Uname$)   :name$="Sprites"
  164.  1770           WHEN "SPRITES22"  :PROCrename("Sprites22",Uname$) :name$="Sprites22"
  165.  1780           WHEN "SPRITES23"  :PROCrename("Sprites23",Uname$) :name$="Sprites23"
  166.  1790           WHEN "SETUP"      :PROCrename("Setup",Uname$)     :name$="Setup"
  167.  1800           WHEN "TEMPLATES"  :PROCrename("Templates",Uname$) :name$="Templates"
  168.  1810           WHEN "!CHOICES"   :PROCrename("!Choices",Uname$)  :name$="!Choices"
  169.  1820           WHEN "!SETUP"     :PROCrename("!Setup",Uname$)    :name$="!Setup"
  170.  1830           WHEN "DESC"       :PROCrename("Desc",Uname$)      :name$="Desc"
  171.  1840           WHEN "MENU"       :PROCrename("Menu",Uname$)      :name$="Menu"
  172.  1841           WHEN "!MENU"      :PROCrename("!Menu",Uname$)     :name$="!Menu"
  173.  1850           WHEN "!CONFIG"    :PROCrename("!Config",Uname$)   :name$="!Config"
  174.  1860           WHEN "SOURCE"     :PROCrename("Source",Uname$)    :name$="Source"
  175.  1870           WHEN "RUNIMAGERB" :PROCrename("RunImageRB",Uname$):name$="RunImageRB"
  176.  1880           WHEN "README"     :PROCrename("ReadMe",Uname$)    :name$="ReadMe"
  177.  1890           WHEN "INTMETRICS" :PROCrename("IntMetrics",Uname$):name$="IntMertics"
  178.  1900           WHEN "OUTLINES"   :PROCrename("Outlines",Uname$)  :name$="Outlines"
  179.  1930           WHEN "OBJECT"     :PROCrename("Object",Uname$)    :name$="Object"
  180.  1940         ENDCASE
  181.  1960       rootname$=root$+"."+name$
  182.  1963       cfsrootname$="CFS#"+root$+"."+name$
  183.  1965       ENDIF
  184.  1966       :
  185.  1970       REM Only continue processing if the file is type "CFSlzw"
  186.  1971       T%=0
  187.  1972       S%=0
  188.  1980       IF TYPE$="D96" THEN
  189.  1990         :
  190.  2000         IF (INSTR("DDC 3FB FF8 FC8 D69 C14 FF6",CFSTYPE$,1)<>0) THEN T%=1
  191.  2001         IF (CFSlength%<=length%) OR (CFSlength1%=length1%) THEN S%=1
  192.  2002         IF S%=1 OR T%=1 THEN
  193.  2010           OSCLI("Copy "+cfsrootname$+" "+rootname$+" F~C~V")
  194.  2020           PRINT STRING$(Len%,CHR$127);"     File Info : Type - ";CFSTYPE$;" - Len - ";CFSlength%;" (";CFSlength1%;"k) : Compressed Len - ";length%;" (";length1%;"k)"
  195.  2030           PRINT"        Reason : File decompressed due to ";
  196.  2031           IF T%=1 THEN PRINT "file type ";CFSTYPE$ ELSE PRINT "file size ";CFSlength%;" bytes"
  197.  2040           PRINT"Processed file : ";rootname$'
  198.  2050           Len%=0
  199.  2060           fixed%+=1
  200.  2070           :
  201.  2080           ELSE
  202.  2090           :
  203.  2100           REM To speed up directory viewer uncompress !Boot and !Sprite files
  204.  2110           IF Uname$="!BOOT" OR LEFT$(Uname$,8)="!SPRITES" THEN
  205.  2120             OSCLI("Copy "+cfsrootname$+" "+rootname$+" F~C~V")
  206.  2130             PRINT STRING$(Len%,CHR$127);"     File Info : Type - ";CFSTYPE$;" - Len - ";CFSlength%;"(";CFSlength1%;"k) : Compressed Len - ";length%;"(";length1%;"k)"
  207.  2140             PRINT"        Reason : ";Uname$;" file decompressed"
  208.  2150             PRINT"Processed file : ";rootname$'
  209.  2160             Len%=0
  210.  2170             fixed%+=1
  211.  2180           ENDIF
  212.  2190         ENDIF
  213.  2200       ENDIF
  214.  2210       :
  215.  2240       ELSE
  216.  2260       REM Process the next directory level down
  217.  2270       PROCscan(rootname$)
  218.  2280     ENDIF
  219.  2290   ENDIF
  220.  2300 UNTIL off%<0
  221.  2310 ENDPROC
  222.  2320 :
  223.  2330 DEFFNreadtype(name$)
  224.  2340 SYS "OS_File",5,name$ TO ,,loadaddr
  225.  2350 =MID$(STR$~(loadaddr),4,3)
  226.  2360 :
  227.  2370 DEFFNupper(n$)
  228.  2380 nn$=""
  229.  2390 :
  230.  2400 REM #noturbo
  231.  2410 FORX%=1 TO LEN(n$)
  232.  2420   A%=ASC(MID$(n$,X%,1))
  233.  2430   IF A%<123 THEN
  234.  2440     IF A%>96 THEN
  235.  2450       A%-=32
  236.  2460     ENDIF
  237.  2470   ENDIF
  238.  2480   nn$+=CHR$(A%)
  239.  2490 NEXT
  240.  2500 REM #turbo
  241.  2510 :
  242.  2520 =nn$
  243.  2530 :
  244.  2540 REM Get the value of a system variable
  245.  2550 DEF FNread_system_variable_value(variable$)
  246.  2560 LOCAL value_length%
  247.  2570 $variable% = variable$ + CHR$0
  248.  2580 SYS"OS_ReadVarVal",variable%,value%,1024,0,3 TO ,,value_length%
  249.  2590 ?(value% + value_length%) = 13
  250.  2600 = $value%
  251.  2610 :
  252.  2620 REM Check format
  253.  2630 DEFPROCrename(c$,Uc$)
  254.  2640 IF done%=1 THEN ENDPROC
  255.  2650 IF name$=c$ THEN DONE%=1:ENDPROC
  256.  2660 IF name$<>c$ THEN
  257.  2670   IF Uc$=Uname$ THEN
  258.  2680     PROCReformat(rootname$,root$+"."+c$)
  259.  2690     done%=1
  260.  2700   ENDIF
  261.  2710 ENDIF
  262.  2720 ENDPROC
  263.  2730 :
  264.  2740 REM Reformat the filename
  265.  2750 DEFPROCReformat(n$,nn$)
  266.  2760 LOCAL ERROR
  267.  2770 ON ERROR LOCAL PRINT "*    File open : ";nn$:errors%=+1:ENDPROC
  268.  2780 OSCLI("ACCESS "+n$+" RW")
  269.  2790 OSCLI("RENAME "+n$+" "+nn$)
  270.  2800 RESTORE ERROR
  271.  2810 :
  272.  2820 PRINT STRING$(Len%,CHR$127);"     File Info : Type - ";CFSTYPE$;" - Len - ";CFSlength%;"(";CFSlength1%;"k) : Compressed Len - ";length%;"(";length1%;"k)"
  273.  2830 PRINT"        Reason : File name renamed"
  274.  2840 PRINT"  Renamed file : ";n$
  275.  2850 PRINT"       To file : ";nn$'
  276.  2860 Len%=0
  277.  2870 rename%+=1
  278.  2900 ENDPROC
  279.  2910 :
  280.  2920 DEFFNtwo(A%)
  281.  2930 A$=STR$(A%)
  282.  2940 IFLEN(A$)=1 THENA$="0"+A$
  283.  2950 =A$
  284.  2960 :
  285.  2970 REM Error handler
  286.  2980 DEFPROCerror
  287.  2990 IF ERR = 17 THEN
  288.  3000   PRINT''"Program aborted by user....":SYS"Hourglass_Off":ON
  289.  3010   PRINT '"Re-compacting drive...... ";Drive$;"   ";
  290.  3020   REPEAT
  291.  3030     T%=TIME
  292.  3040     OSCLI("COMPACT "+Drive$)
  293.  3050   UNTIL (TIME - T%) < 5
  294.  3060   PRINT "(Finished)"
  295.  3070   END
  296.  3080 ENDIF
  297.  3090 :
  298.  3100 REPORT:PRINT;" at line ";ERL:SYS"Hourglass_Off":ON:END
  299.  3110 ENDPROC
  300.  3120
  301.